Mac-Source 1994 July/Mac-Source_July_1994.iso/C and C++/Libraries/SAT/HeartQuest sample ƒ/main.p

Text File | 1993-09-19 | 7.7 KB | 272 lines | [TEXT/PJMM]

{================================================}
{=============== HeartQuest main unit ================}
{================================================}

{ Example file for Ingemars Sprite Animation Toolkit. }
{ © Ingemar Ragnemalm 1992 }
{ See doc files for legal terms for using this code. }

{ HeartQuest is a very simple game demonstrating how to use the Sprite Animation}
{ Toolkit. I originally wrote the game as my present to my wife Eva for Valentine's}
{ day 1992. You can still tell that this file once started as the Skel example in the}
{ TransSkel package by Paul duBois. }

{ This "main" file is rather small, and holds very little game specific code.}
{ Its main concern is to initialize the various parts of the game, and to hold the}
{ file and edit menu handlers. }

program HeartQuest;

    uses
        TransSkel, SAT, GameGlobals, GameWind, {sound,}
        SoundConst, scores, CenterStuff;

{Variables for the main program}
    var
        keys: KeyMap;
        ZoomFlag: Boolean;
        ignore: longint; {For UnloadScrap error}

{ -------------------------------------------------------------------- }
{                        Menu handling procedures                        }
{ -------------------------------------------------------------------- }

{    Handle selection of "About…" item from Apple menu}

    procedure DoAbout;
        var
            h: StringHandle;
            ignore: integer;
    begin
{SetParamText(aboutStr);}
        ignore := DoAlert(43, aboutAlrt, nil);
    end;

{    Process selection from File menu.}

{    HelpEnemies    Shows a help box. }
{    Quit    Request a halt by calling SkelHalt().  This makes SkelMain}
{            return.}

    procedure DoFileMenu (item: integer);
        var
            ignore: integer;
    begin
        case item of
            helpenemies:
                ignore := DoAlert(43, helpenemiesAlrt, nil);
            quit:
                begin
                    if pauseFlag then
                        DoGameOver;
                    SkelWhoa;
                end;
            otherwise
                ;
        end;
    end;

    procedure DoEditMenu;
    begin
    end;

{    Initialize menus.  Tell TransSkel to process the Apple menu}
{    automatically, and associate the proper procedures with the}
{    File and Edit menus.}

    procedure SetUpMenus;
    begin
        SkelApple('About HeartQuest…', @DoAbout);
        fileMenu := GetMenu(fileMenuRes);
        editMenu := GetMenu(editMenuRes);
        GameMenu := GetMenu(GameMenuRes);
        highMenu := GetMenu(highMenuRes);
        dummy := SkelMenu(fileMenu, @DoFileMenu, nil, false);
        dummy := SkelMenu(editMenu, @DoEditMenu, nil, false);
        dummy := SkelMenu(GameMenu, @DoGameMenu, nil, false);
        dummy := SkelMenu(highMenu, @DoHighMenu, nil, true);
    end;

{ Initialize settings resources. These are saved in the game file itself. This is elegant,}
{ but a bit "server-hostile". An alternative is to create a preference file in the system}
{ folder. }

    procedure InitSettings;
    begin
        features := featHnd(GetResource('Feat', 0));        { Load the settings }
        if features = nil then                                { Settings doesn't exist; create new }
            begin
                features := featHnd(NewHandle(Sizeof(featRec)));
                CheckNoMem(Ptr(features));
                features^^.sound := true;
                features^^.allowBG := false;
                features^^.player := 'Anonymous';
                features^^.macho := false;
                AddResource(handle(features), 'Feat', 0, 'Settings');
            end;
{ Fix all checkmarks in the menus }
        if features^^.sound then
            begin
                features^^.sound := false;
                DoGameMenu(sound);
            end
        else
            begin
                features^^.sound := true;
                DoGameMenu(sound);
            end;
        if features^^.macho then
            begin
                features^^.macho := false;
                DoGameMenu(macho);
            end
        else
            begin
                features^^.macho := true;
                DoGameMenu(macho);
            end;
        if features^^.PlotFast then
            begin
                features^^.PlotFast := false;
                DoGameMenu(FastAnimation);
            end
        else
            begin
                features^^.PlotFast := true;
                DoGameMenu(FastAnimation);
            end;
        if features^^.allowBG then
            begin
                features^^.allowBG := false;
                DoGameMenu(allowBG);
            end
        else
            begin
                features^^.allowBG := true;
                DoGameMenu(allowBG);
            end;
    end;

{ Hide gameWindow on suspend, so the user can get access to disk icons etc. }

    procedure DoSuspendResume (b: boolean);
    begin
        if b then
            begin
                showwindow(gameWind);
                selectwindow(gameWind);
            end
        else
            hidewindow(gameWind)
    end;

    function DoEvt (e: eventRecord): boolean;
    begin
        if e.what = OSevt then
            begin
                if BAND(BROTL(e.message, 8), $FF) = SuspendResumeMessage then
                    DoSuspendResume(BAnd(e.message, 1) <> 0);
                DoEvt := true;
            end
        else
            DoEvt := false;
    end; (* end DoEvent *)


{Do a quick approximation of how much memory we need.}
    function GetMemoryDemand: Longint;
        const
            FaceCount = 19;
            SpriteCount = 30; {We can get *lots* of sprites in this game!}
        var
            theWorld: SysEnvRec;
            error: OSerr;
            TestDepth, TestHeight, TestWidth: Longint;
            OffScreenMem, FaceMem: Longint;
    begin
{SAT will set the ColorFlag later, but we set it right now since we want to check the screen depth}
{before SAT knows what screen it will use.}
        error := SysEnvirons(1, theWorld);
        if error = noErr then
            ColorFlag := theWorld.hasColorQD
        else
            ColorFlag := false; {If SysEnvirons won't work, let's assume we don't have color.}

        if ColorFlag then
            TestDepth := GetMainDevice^^.gdPMap^^.pixelSize
        else
            TestDepth := 1;

{Dimensions of game area, zoom or not, plus extra margins}
        if ZoomFlag then
            begin
                TestHeight := GetMainDevice^^.gdPMap^^.bounds.bottom - GetMainDevice^^.gdPMap^^.bounds.top + 128;
                TestWidth := GetMainDevice^^.gdPMap^^.bounds.right - GetMainDevice^^.gdPMap^^.bounds.left + 128;
            end
        else
            begin
                TestHeight := 322 + 128;
                TestWidth := 512 + 128;
            end;

{Sum an approximation of the amount of memory needed.}
{Many calculations are not simplified below for clarity}
{Note that many small memory structures are not counted, so we have to reserve a bit extra}
{in the end.}

        OffScreenMem := TestDepth * TestHeight * TestWidth div 8; {Size of pixel data of one offscreen buffer.}
        FaceMem := (32 * 32 * TestDepth div 8) + sizeof(Sprite);
        if TestDepth = 4 then
            FaceMem := FaceMem * 2; {In 4 bits, we need a bit more, close to twice the amount}

        GetMemoryDemand := 2 * OffScreenMem + FaceCount * FaceMem + SpriteCount * sizeof(sprite);
    end;

{ -------------------------------------------------------------------- }
{                                    Main                                }
{ -------------------------------------------------------------------- }

begin
    SkelInit(6, nil);                { initialize }
    SetUpMenus;                { install menu handlers }

{Is the user holding down a modifier key? If so, we should use the whole screen.}
    GetKeys(keys);
    ZoomFlag := keys[55] or keys[56] or keys[58] or keys[59]; {cmd, shift, alt, ctrl}

{Before starting, check if we have enough memory! UnloadScrap, check depth and dimensions against FreeMem}
    ignore := UnloadScrap; {Ignore any error}

    if GetMemoryDemand + 50000 > FreeMem then {Unreasonably little memory!}
        begin
            ReportStr('Too little memory. Give me some more (or use fewer colors).');
            halt; {We can quit without any cleanup. (I.e. we havn't allocated any sound channel.)}
        end;

    ConfigureSAT(true, VPositionSort, KindCollision, 32);
{ Initialize the Sprite Animation Toolkit, set up offscreen buffers and make the window. }

    if ZoomFlag then {if cmd, shift, alt, ctrl}
        gameWind := InitSAT(0, 0, 32000, 32000) {132, 133}
    else
        gameWind := InitSAT(0, 0, 512, 322); {132, 133}

{ Init all the different parts of the game. }
    GameWindInit;    { Init the game window }
    loadsounds;        { preload all sound resources }
    initScores;        { Init the score module }
    InitSettings;    { Load the settings }

{ Set the randseed to something that is random enough. }
    randSeed := TickCount;

{    SetPort(gameWind);}
{    BackColor(WhiteColor);}
{    Invalrect(gameWind^.portrect);}

    SkelEventHook(@DoEvt); { handle MultiFinder-events }

    SkelMain;                { loop 'til Quit selected }
    SkelClobber;                { clean up }
    SATSoundShutUp;            { Terminate sounds }
end.